home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / examples / misc / tetris.pro < prev    next >
Encoding:
Text File  |  1997-07-08  |  27.0 KB  |  704 lines
  1. ; $Id: tetris.pro,v 1.2 1996/12/17 23:42:52 ali Exp $
  2.  
  3. ;======================================================================
  4. ;       IDL Tetris,
  5. ;       Ray Sterner, 23 and 25 June, 1991
  6. ;
  7. ;       IDL version of Tetris.
  8. ;       This program is composed of the following routines:
  9. ;
  10. ;       t_init  = initializes the screen and internal arrays.
  11. ;                 Sets up colors and shape tables.
  12. ;       t_next  = selects next piece to play.
  13. ;       t_drop  = Drops the piece down one position.
  14. ;       t_left  = Moves piece one position left.
  15. ;       t_right = Moves piece one position right.
  16. ;       t_rot   = Rotates piece by 90 CCW.
  17. ;       t_plot  = Plots or erases piece.
  18. ;       t_score = Handles a score, lights up line
  19. ;                 and squeezes it out.
  20. ;       tetris  = Main control program.
  21. ;
  22. ;======================================================================
  23. ;-----  t_init.pro = tetris init  ----------
  24. ;       R. Sterner, 23 Jun, 1991
  25.  
  26.         pro t_init, wt, lev, bell=bell
  27.  
  28.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  29.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  30.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  31.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  32.         ;--------  Common variables  -------------
  33.         ;  t_nx, t_ny = X and Y size of playing board.
  34.         ;  t_brd = playing board.
  35.         ;  t_p = current playing piece (used only in t_next?).
  36.         ;  t_seed = random seed used in t_next to get next piece.
  37.         ;  t_r = current rotation (0-3).
  38.         ;  t_x, t_y = current reference point. This is what drops each
  39.         ;    cycle, and can be moved left and right.
  40.         ;  t_pxa, t_pya = X and Y offset for all pieces.
  41.         ;  t_px, t_py = X and Y offsets for current piece.
  42.         ;  t_ca = colors for all pieces.
  43.         ;  t_c = current piece color.
  44.         ;  t_bell = Ring bell for each line scored?
  45.         ;  t_wait = drop cycle delay time.
  46.         ;  t_pflst = array of last element numbers for piece outlines.
  47.         ;  t_pfxa, t_pfya = table of all piece outlines, all rotations.
  48.         ;  t_pfx, t_pfy = current piece outline.
  49.         ;  t_pc, t_hpc = # pieces played in game and IDL session.
  50.         ;  t_ln, t_hln = # lines scored in game and IDL session.
  51.         ;  t_sc, t_hsc = score for game and IDL session.
  52.         ;-------------------------------------------------
  53.  
  54.         ;--------  init board  --------
  55.         t_bell = 0
  56.         if keyword_set(bell) then t_bell = 1    ; Ring bell when line complete?
  57.         if n_elements(wt) eq 0 then wt = -1.    ; Time delay.
  58.         if wt eq -1. then wt = 0.05             ; Default time delay.
  59.         t_wait = wt                             ; Wait in sec between drops.
  60.         if n_elements(t_hln) eq 0 then t_hln = 0  ; High scores.
  61.         if n_elements(t_hpc) eq 0 then t_hpc = 0
  62.         if n_elements(t_hsc) eq 0 then t_hsc = 0
  63.         t_nx = 11                               ; Size in X. (+1)
  64.         t_ny = 21                               ; Size in Y. (+1)
  65.         t_brd = bytarr(t_nx-1, t_ny)            ; Board.
  66.  
  67.         ;-----  Set up random starting pieces  -----
  68.         ;-----  If level < 0 then plot these pieces in gray (8) ----
  69.         if abs(lev) gt 0 then begin
  70.           lset = (byte(randomu(i,t_nx-1,abs(lev))*8)<7B)* $
  71.                  byte(randomu(i,t_nx-1,abs(lev)) gt .5)
  72.           if lev lt 0 then lset = 8*(lset ne 0)          
  73.           t_brd[0,0] = lset
  74.         endif
  75.  
  76.  
  77.         ;--------  Set up piece color array  -------
  78.         t_ca = [1,2,3,4,5,6,7,8]
  79.  
  80.         ;--------  Set up pieces  ------
  81.         ;--------  As offsets:  ----------
  82.         ;---  Set up X offsets for 7 4 part pieces, each with 4 rotations --
  83.         t_pxa = intarr(4,4,7)
  84.         t_pxa[0,0,0] = [[0,1,0,1], $   ; Piece # 0:  X X
  85.                         [0,1,0,1], $   ;             X X
  86.                         [0,1,0,1], $
  87.                         [0,1,0,1]]
  88.  
  89.         t_pxa[0,0,1] = [[-2,-1,0,1], $ ; Piece # 1: X X X X
  90.                         [0,0,0,0], $
  91.                         [-2,-1,0,1],$
  92.                         [0,0,0,0]]
  93.  
  94.         t_pxa[0,0,2] = [[-1,0,1,0], $  ; Piece # 2:  X X X
  95.                         [0,0,0,1], $   ;               X
  96.                         [-1,0,1,0], $
  97.                         [0,0,0,-1]]
  98.  
  99.         t_pxa[0,0,3] = [[-1,0,0,1], $  ; Piece # 3:    X X
  100.                         [0,0,-1,-1], $ ;                 X X
  101.                         [0,-1,-1,-2], $
  102.                         [-1,-1,0,0]]
  103.  
  104.         t_pxa[0,0,4] = [[-1,0,0,1], $  ; Piece # 4:      X X
  105.                         [-1,-1,0,0], $ ;               X X
  106.                         [0,-1,-1,-2], $
  107.                         [0,0,-1,-1]]
  108.  
  109.         t_pxa[0,0,5] = [[-1,0,1,1],$   ; Piece # 5:    X X X
  110.                         [0,0,0,1], $   ;                   X
  111.                         [1,0,-1,-1], $
  112.                         [0,0,0,-1]]
  113.  
  114.         t_pxa[0,0,6] = [[1,0,-1,-1],$  ; Piece # 6:    X X X
  115.                         [0,0,0,1],$    ;               X
  116.                         [-1,0,1,1],$
  117.                         [0,0,0,-1]]
  118.  
  119.         ;---  Set up Y offsets for 7 4 part pieces, each with 4 rotations --
  120.         t_pya = intarr(4,4,7)
  121.  
  122.         t_pya[0,0,0] = [[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1]]
  123.         t_pya[0,0,1] = [[0,0,0,0],[-2,-1,0,1],[0,0,0,0],[-2,-1,1,0]]
  124.         t_pya[0,0,2] = [[0,0,0,-1],[-1,0,1,0],[0,0,0,1],[1,0,-1,0]]
  125.         t_pya[0,0,3] = [[0,0,-1,-1],[0,-1,-1,-2],[-1,-1,0,0],[-1,0,0,1]]
  126.         t_pya[0,0,4] = [[-1,-1,0,0],[0,-1,-1,-2],[0,0,-1,-1],[-1,0,0,1]]
  127.         t_pya[0,0,5] = [[0,0,0,-1],[-1,0,1,1],[0,0,0,1],[1,0,-1,-1]]
  128.         t_pya[0,0,6] = [[0,0,0,-1],[1,0,-1,-1],[0,0,0,1],[-1,0,1,1]]
  129.  
  130.         ;------  Setup pieces as outlines  ---------
  131.         t_pflst = [3,3,7,7,7,5,5]       ; Last outline point #.
  132.         t_pfxa = intarr(8,4,7)
  133.         t_pfxa[0,0,0] = [[0,2,2,0,0,0,0,0],$
  134.                          [0,2,2,0,0,0,0,0],$
  135.                          [0,2,2,0,0,0,0,0],$
  136.                          [0,2,2,0,0,0,0,0]]
  137.         t_pfxa[0,0,1] = [[-2,2,2,-2,0,0,0,0],$
  138.                          [0,1,1,0,0,0,0,0],$
  139.                          [-2,2,2,-2,0,0,0,0],$
  140.                          [0,1,1,0,0,0,0,0]]
  141.         t_pfxa[0,0,2] = [[-1,0,0,1,1,2,2,-1],$
  142.                          [0,1,1,2,2,1,1,0],$
  143.                          [-1,2,2,1,1,0,0,-1],$
  144.                          [-1,0,0,1,1,0,0,-1]]
  145.         t_pfxa[0,0,3] = [[-1,0,0,2,2,1,1,-1],$
  146.                          [-1,0,0,1,1,0,0,-1],$
  147.                          [-2,-1,-1,1,1,0,0,-2],$
  148.                          [-1,0,0,1,1,0,0,-1]]
  149.         t_pfxa[0,0,4] = [[-1,1,1,2,2,0,0,-1],$
  150.                         [0,1,1,0,0,-1,-1,0],$
  151.                         [-2,0,0,1,1,-1,-1,-2],$
  152.                         [0,1,1,0,0,-1,-1,0]]
  153.         t_pfxa[0,0,5] = [[-1,1,1,2,2,-1,0,0],$
  154.                          [0,1,1,2,2,0,0,0],$
  155.                          [-1,2,2,0,0,-1,0,0],$
  156.                          [-1,1,1,0,0,-1,0,0]]
  157.         t_pfxa[0,0,6] = [[-1,0,0,2,2,-1,0,0],$
  158.                          [0,2,2,1,1,0,0,0],$
  159.                          [-1,2,2,1,1,-1,0,0],$
  160.                          [0,1,1,-1,-1,0,0,0]]
  161.         t_pfya = intarr(8,4,7)
  162.         t_pfya[0,0,0] = [[0,0,2,2,0,0,0,0],$
  163.                          [0,0,2,2,0,0,0,0],$
  164.                          [0,0,2,2,0,0,0,0],$
  165.                          [0,0,2,2,0,0,0,0]]
  166.         t_pfya[0,0,1] = [[0,0,1,1,0,0,0,0],$
  167.                          [-2,-2,2,2,0,0,0,0],$
  168.                          [0,0,1,1,0,0,0,0],$
  169.                          [-2,-2,2,2,0,0,0,0]]
  170.         t_pfya[0,0,2] = [[0,0,-1,-1,0,0,1,1],$
  171.                          [-1,-1,0,0,1,1,2,2],$
  172.                          [0,0,1,1,2,2,1,1],$
  173.                          [0,0,-1,-1,2,2,1,1]]
  174.         t_pfya[0,0,3] = [[0,0,-1,-1,0,0,1,1],$
  175.                          [-2,-2,-1,-1,1,1,0,0],$
  176.                          [0,0,-1,-1,0,0,1,1],$
  177.                          [-1,-1,0,0,2,2,1,1]]
  178.         t_pfya[0,0,4] = [[-1,-1,0,0,1,1,0,0],$
  179.                          [-2,-2,0,0,1,1,-1,-1],$
  180.                          [-1,-1,0,0,1,1,0,0],$
  181.                          [-1,-1,1,1,2,2,0,0]]
  182.         t_pfya[0,0,5] = [[0,0,-1,-1,1,1,0,0],$
  183.                          [-1,-1,1,1,2,2,0,0],$
  184.                          [0,0,1,1,2,2,0,0],$
  185.                          [-1,-1,2,2,0,0,0,0]]
  186.         t_pfya[0,0,6] = [[-1,-1,0,0,1,1,0,0],$
  187.                          [-1,-1,0,0,2,2,0,0],$
  188.                          [0,0,2,2,1,1,0,0],$
  189.                          [-1,-1,2,2,1,1,0,0]]
  190.  
  191.         ;-------  Scale board to screen  --------
  192.         plot,[0,t_nx-1],[0,t_ny-1],position=[.1,.1,.4,.9],/xsty,/ysty,/nodata
  193.         ;-------  Outline board  -----------------
  194.         erase
  195.         polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
  196.           color=10
  197.         polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
  198.           color=9, spacing=.15, orient=0
  199.         polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
  200.           color=9, spacing=.15, orient=90
  201.         polyfill,[-.2,t_nx-.8,t_nx-.8,-.2],$
  202.           [-.2,-.2,t_ny-.8,t_ny-.8]
  203.         polyfill,[0,1,1,0]*(t_nx-1),[0,0,1,1]*(t_ny-1), color=0
  204.         plots,[-1,t_nx,t_nx,-1,-1],[-1,-1,t_ny,t_ny,-1],thick=3
  205.  
  206.         ;------  Show starting board  --------
  207.         if abs(lev) gt 0 then begin
  208.           for iy = 0, abs(lev) do begin
  209.             for ix = 0, t_nx-2 do begin
  210.               c = t_brd[ix,iy]
  211.               polyfill, [0,1,1,0]+ix, [0,0,1,1]+iy, color=c
  212.             endfor
  213.           endfor
  214.         endif
  215.  
  216.         ;------  Menu  -----
  217.         xyouts, 350-25, 280+30, /dev, size=1.2, '!3J = Move left'
  218.         xyouts, 475, 280+30, /dev, size=1.2, 'L = Move right'
  219.         xyouts, 350-25, 260+30, /dev, size=1.2, 'SPACE = Rotate'
  220.         xyouts, 475, 260+30, /dev, size=1.2, 'H = Help'
  221.         xyouts, 475, 240+30, /dev, size=1.2, 'Q = Quit'
  222.         xyouts, 350-25, 240+30, /dev, size=1.2, 'S = Start'
  223.         xyouts, 350-25, 220+30, /dev, size=1.2, 'P = Pause/unpause'
  224.  
  225.  
  226.         xyouts, 420, 190, 'Game', size=1.8, /dev
  227.         xyouts, 520, 190, 'Session', size=1.8, /dev
  228.         xyouts, 320, 160, 'Pieces:',size=1.8, /dev
  229.         xyouts, 320, 130, 'Lines:',size=1.8, /dev
  230.         xyouts, 320, 100, 'Score:',size=1.8, /dev
  231.  
  232.         t_pc = 0        ; Current score.
  233.         t_ln = 0
  234.         t_sc = 0
  235.         xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2)
  236.         xyouts, /dev, 520, 160, size=1.8, strtrim(t_hpc,2)
  237.         xyouts, /dev, 420, 130, size=1.8, strtrim(t_ln, 2)
  238.         xyouts, /dev, 520, 130, size=1.8, strtrim(t_hln, 2)
  239.         xyouts, /dev, 420, 100, size=1.8, strtrim(t_sc, 2)
  240.         xyouts, /dev, 520, 100, size=1.8, strtrim(t_hsc, 2)
  241.  
  242.  
  243.         ;-------  Load color table  --------
  244.         tvlct, $
  245.           [0,255,255,127,255,127,255,127,128,255,  0,  0,255,255,255,255],$
  246.           [0,127,127,255,255,127,189,255,128,255,  0,255,  0,255,255,255],$
  247.           [0,127,255,255,127,255,127,127,128,255,255,233,  0,  0,  0,255]
  248.  
  249.         ;---------  Make title  --------
  250.         xyouts, 25+300, 400+15, /dev, size=3, '!17IDL Tetris', color=10
  251.         xyouts, 25+301, 401+15, /dev, size=3, '!17IDL Tetris', color=10
  252.         xyouts, 25+302, 402+15, /dev, size=3, '!17IDL Tetris', color=11
  253.         xyouts, 25+303, 403+15, /dev, size=3, '!17IDL Tetris', color=11
  254.         xyouts, 25+304, 404+15, /dev, size=3, '!17IDL Tetris', color=12
  255.         xyouts, 25+305, 405+15, /dev, size=3, '!17IDL Tetris', color=12
  256.         xyouts, 25+306, 406+15, /dev, size=3, '!17IDL Tetris', color=13
  257.         xyouts, 25+307, 407+15, /dev, size=3, '!17IDL Tetris', color=13
  258.  
  259.         xyouts, /dev, size=2, 23+392, 370+13, '!13by', color=12
  260.         xyouts, /dev, size=2, 23+342, 336+13, '!13Ray Sterner!3', color=12
  261.         xyouts, /dev, size=2, 24+392, 370+14, '!13by', color=12
  262.         xyouts, /dev, size=2, 24+342, 336+14, '!13Ray Sterner!3', color=12
  263.         xyouts, /dev, size=2, 25+392, 370+15, '!13by', color=6
  264.         xyouts, /dev, size=2, 25+342, 336+15, '!13Ray Sterner!3', color=6
  265.  
  266.  
  267.         return
  268.         end
  269.  
  270. ;======================================================================
  271. ;--------  t_next = get next piece ready  ------
  272. ;       R. Sterner, 23 Jun, 1991
  273.  
  274.         pro t_next, pn
  275.  
  276.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  277.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  278.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  279.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  280.  
  281.         if n_elements(pn) eq 0 then begin
  282.           t_p = byte(randomu(t_seed)*7)  ; Pick a random piece #.
  283.         endif else t_p = pn          ; Use selected piece number.
  284.         t_r = 0                      ; Start in standard position.
  285.         t_c = t_ca[t_p]              ; Look up piece color.
  286.         t_px = t_pxa[*, t_r, t_p]    ; Pull out correct offsets.
  287.         t_py = t_pya[*, t_r, t_p]
  288.         t_pfx = t_pfxa[0:t_pflst[t_p],t_r,t_p]    ; Extract outline.
  289.         t_pfy = t_pfya[0:t_pflst[t_p],t_r,t_p]
  290.         t_x = t_nx/2                 ; Starting position.
  291.         t_y = t_ny
  292.  
  293.         return
  294.         end
  295.  
  296. ;======================================================================
  297. ;-------  t_drop = drop a piece one position  ------
  298. ;       R. Sterner, 23 Jun, 1991
  299.  
  300.         pro t_drop, done=done, range=range
  301.  
  302.        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  303.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  304.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  305.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  306.  
  307.         t_plot, 0       ; Erase current position.
  308.         t_y = t_y - 1   ; Drop one position.
  309.  
  310.         flag = 0                                ; Undo flag.
  311.         if min(t_y + t_py) lt 0 then flag = 1   ; Hit bottom.
  312.         if max(t_brd[t_x+t_px, t_y+t_py]) gt 0 then flag = 1    ; Collision.
  313.  
  314.         done = 0                                ; Assume not done yet.
  315.         if flag eq 1 then begin                 ; Done.
  316.           t_y = t_y + 1                         ; Can't move down.
  317.           t_brd[t_x+t_px, t_y+t_py] = t_c       ; Update board with color.
  318.           done = 1                              ; Set done flag.
  319.           range = [min(t_y+t_py), max(t_y+t_py)]  ; Range to check.
  320.         endif
  321.  
  322.         t_plot, 1       ; Plot new position.
  323.         wait, t_wait
  324.  
  325.         return
  326.         end
  327.  
  328. ;======================================================================
  329. ;-------  t_left = move piece one position left ------
  330. ;       R. Sterner, 23 Jun, 1991
  331.  
  332.         pro t_left
  333.  
  334.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  335.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  336.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  337.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  338.  
  339.         t_plot, 0                               ; Erase current position.
  340.  
  341.         t_x = t_x - 1                           ; Shift left 1.
  342.  
  343.         flag = 0                                ; Undo flag.
  344.         if min(t_x + t_px) lt 0 then flag = 1   ; Out of bounds.
  345.         if max(t_brd[t_x+t_px, t_y+t_py]) gt 0 then flag = 1    ; Collision.
  346.  
  347.         if flag eq 1 then t_x = t_x + 1         ; Undo.
  348.  
  349.         t_plot, 1                               ; Plot new position.
  350.  
  351.         return
  352.         end
  353.  
  354.  
  355. ;======================================================================
  356. ;-------  t_right = move piece one position right ------
  357. ;       R. Sterner, 23 Jun, 1991
  358.  
  359.         pro t_right
  360.  
  361.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  362.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  363.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  364.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  365.  
  366.         t_plot, 0             ; Erase current position.
  367.  
  368.         t_x = t_x + 1         ; Shift right 1.
  369.                               
  370.         flag = 0              ; Undo flag.
  371.         if max(t_x + t_px) gt (t_nx-2) then flag = 1    ; Out of bounds.
  372.         if max(t_brd[t_x+t_px, t_y+t_py]) gt 0 then flag = 1    ; Collision.
  373.  
  374.         if flag eq 1 then t_x = t_x - 1                 ; Undo.
  375.  
  376.         t_plot, 1                                       ; Plot new position.
  377.  
  378.         return
  379.         end
  380.  
  381. ;======================================================================
  382. ;-------  t_rot = rotate a piece one position  ------
  383. ;       R. Sterner, 23 Jun, 1991
  384.  
  385.         pro t_rot
  386.  
  387.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  388.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  389.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  390.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  391.  
  392.         t_plot, 0               ; Erase current position.
  393.  
  394.         t_r = (t_r + 1) mod 4   ; Rotate.
  395.         t_px = t_pxa[*,t_r,t_p] ; Extract new offsets.
  396.         t_py = t_pya[*,t_r,t_p]
  397.         t_pfx = t_pfxa[0:t_pflst[t_p],t_r,t_p]    ; Extract outline.
  398.         t_pfy = t_pfya[0:t_pflst[t_p],t_r,t_p]
  399.  
  400.         ;----  Check for out of bounds or collision. -----
  401.         flag = 0                ; Undo flag.
  402.         ;------  Don't rotate out the sides  ---------
  403.         if (min(t_x+t_px) lt 0) or (max(t_x+t_px) gt (t_nx-2)) then flag = 1
  404.         ;------  Don't rotate out the bottom  -----
  405.         if (min(t_y+t_py) lt 0) then flag = 1
  406.         ;------  Check collision with another piece  ------
  407.         if max(t_brd[t_x+t_px, t_y+t_py]) gt 0 then flag = 1    ; Collision.
  408.         if flag eq 1 then begin    ; Undo.
  409.           t_r = (t_r + 3) mod 4    ; Rotate 270 = -90.
  410.           t_px = t_pxa[*,t_r,t_p]  ; Extract new offsets.
  411.           t_py = t_pya[*,t_r,t_p]
  412.           t_pfx = t_pfxa[0:t_pflst[t_p],t_r,t_p]    ; Extract outline.
  413.           t_pfy = t_pfya[0:t_pflst[t_p],t_r,t_p]
  414.         endif
  415.  
  416.         t_plot, 1               ; Plot new position.
  417.  
  418.         return
  419.         end
  420.  
  421. ;======================================================================
  422. ;------  t_plot.pro = Erase or draw current tetris piece  ---------
  423. ;       R. Sterner, 23 Jun, 1991
  424.  
  425.         pro t_plot, flag
  426.  
  427.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  428.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  429.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  430.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  431.  
  432.         c = 0
  433.         if flag eq 1 then c = t_c
  434.  
  435.         if max(t_y+t_pfy) lt t_ny then begin
  436.           polyfill, t_x+t_pfx, t_y+t_pfy, color=c
  437.         endif
  438.  
  439.         return
  440.         end
  441.  
  442. ;======================================================================
  443. ;-------  t_score = Look for and process a score.  ------
  444. ;       R. Sterner, 23 Jun, 1991
  445.  
  446.         pro t_score, r
  447.  
  448.         common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  449.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  450.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  451.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  452.  
  453.         ;---------  Add score for this piece  --------
  454.         xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
  455.         t_sc = t_sc + 7      ; Each piece worth 7 pts.
  456.         xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
  457.  
  458.         count = 0                                 ; Lines scored on piece.
  459.         rn = (r[0]+indgen(r[1]-r[0]+1))<(t_ny-1)  ; Range to check.
  460.         for i = 0, n_elements(rn)-1 do begin      ; Check each line.
  461.           if total(t_brd[*,rn[i]] eq 0) eq 0 then begin  ; Score.
  462.            ;---  light up score line  ----
  463.             xp = [0.01,.99,.99,0.01]*(t_nx-1)
  464.             yp = [0.05,0.05,.99,.99]+rn[i]
  465.             polyfill, xp,yp,color=0,spacing=.1,orient=0
  466.             polyfill, xp,yp,color=0,spacing=.1,orient=90
  467.             wait, 0
  468.             ;---  ring bell  -----
  469.             if t_bell then print,string(7b),form='($,a1)'
  470.             ;---  Collapse board  -------
  471.             t_brd[0,rn[i]] = t_brd[*,(rn[i]+1):*]
  472.             ;---  Repaint screen board  -----
  473.             tmp = fltarr(t_ny)
  474.             for j = 0, t_ny-1 do tmp[j] = total(t_brd[*,j])
  475.             mx = 1+max(where(tmp ne 0))
  476.             for z = 0.8, 0., -.2 do begin
  477.             for iy = rn[i], mx do begin
  478.               for ix = 0, t_nx-2 do begin
  479.                 c = t_brd[ix,iy]
  480.                 polyfill, [0,1,1,0]+ix, (z+[0,0,1,1]+iy)<(t_ny-1), color=c
  481.               endfor
  482.             endfor
  483.             endfor  ; Z
  484.             ;---  Decrement range  ------
  485.             rn = rn - 1
  486.             ;----  Count scored line  -----
  487.             count = count + 1
  488.             ;---  Update score board  -----
  489.             xyouts, 420, 130, /dev, size=1.8, strtrim(t_ln,2), color=0
  490.             t_ln = t_ln + 1
  491.             xyouts, 420, 130, /dev, size=1.8, strtrim(t_ln,2)
  492.             xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
  493.             t_sc = t_sc + 22      ; Each line worth 22 pts.
  494.             xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
  495.            endif
  496.         endfor
  497.        
  498.         ;--------  Check for a tetris (4 lines scored on 1 piece) ----
  499.         if count eq 4 then begin
  500.           xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
  501.           t_sc = t_sc + 48      ; 48 extra points.
  502.           xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
  503.         endif
  504.  
  505.         return
  506.         end
  507.  
  508. ;======================================================================
  509. ;-------  t_help.pro = display help text  --------
  510. ;       R. Sterner, 4 Aug, 1991
  511.  
  512.         pro t_help
  513.  
  514.     ver    = WIDGET_INFO(/VERSION)
  515.         if ver.style eq 'MS Windows' then device, set_display=2
  516.         print,' '
  517.         print,' Tetris has 7 different playing pieces which drop down'
  518.         print,' from the top of the screen. Points are scored by'
  519.         print,' fitting these pieces together to form horizontal rows'
  520.         print,' having no gaps. Such complete rows dissolve away and add'
  521.         print," to the player's score. Pieces may be moved left and right"
  522.         print,' and rotated to fit together. The more rows completed the'
  523.         print,' higher the score each newly completed row is worth.'
  524.         print,' Extra credit is given for completing 4 rows at the same'
  525.         print,' time.  Upper or lower case key commands may be used, except'
  526.         print,' that the Q (quit) command must be upper case.'
  527.         print,' Both the current game scores and the highest score during'
  528.         print,' the current session of IDL are displayed.'
  529.         print,' '
  530.         print,' The first version of this project was written using PC IDL'
  531.         print,' in an afternoon as a test of the capabilities of IDL on a'
  532.         print,' 386 class machine.'
  533.         print,' 
  534.         txt = ''
  535.         read,' Press RETURN to continue', txt
  536.         if ver.style eq 'MS Windows' then device, set_display=3
  537.         return
  538.         end
  539.  
  540. ;======================================================================
  541. ;;------  tetris.pro main tetris routine  ------
  542. ;       R. Sterner, 23 Jun, 1991
  543.  
  544.         pro tetris, wait=wt, level=lev, help=hlp, bell=bell, $
  545.           top=top
  546.  
  547. ;+
  548. ; NAME:
  549. ;    TETRIS
  550. ;
  551. ; PURPOSE:
  552. ;    IDL version of the falling blocks game Tetris.
  553. ;
  554. ;    The object of this game is to build solid rows of blocks from the
  555. ;    differently-shaped falling pieces.
  556. ;
  557. ; CATEGORY:
  558. ;    Games.
  559. ;
  560. ; CALLING SEQUENCE:
  561. ;    TETRIS
  562. ;
  563. ; INPUTS:
  564. ;    No required inputs.
  565. ;
  566. ; OUTPUTS:
  567. ;    No explicit outputs.
  568. ;
  569. ; OPTIONAL KEYWORD PARAMETERS:
  570. ;    WAIT:    The delay between moves in seconds.  This parameter adjusts
  571. ;        the playing speed.  The default is 0.05, which may be too
  572. ;        low for faster machines (or beginning players).
  573. ;
  574. ;    LEVEL:    Level of random starting pieces, default = 0.
  575. ;
  576. ;    HELP:    Set this keyword to display help text.
  577. ;
  578. ;    BELL:    Set this keyword to ring the bell for each line scored.
  579. ;
  580. ; COMMON BLOCKS:
  581. ;    Some.
  582. ;
  583. ; SIDE EFFECTS:
  584. ;    A window is created for the game.
  585. ;    Interaction is via keyboard and display.
  586. ;
  587. ; MODIFICATION HISTORY:
  588. ;    Written by Ray Sterner, Johns-Hopkins Applied Physics Research Lab
  589. ;                23 and 25 June, 1991
  590. ;-
  591.  
  592.        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
  593.            t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
  594.            t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
  595.            t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
  596.  
  597.         if keyword_set(hlp) then begin
  598.           print,' Play tetris game.'
  599.           print,' tetris'
  600.           print,' Keywords:'
  601.           print,'   WAIT=tm  Seconds between pieces (def=.05).'  
  602.           print,'     tm = 0 is very fast, 0.1 is slow.'
  603.           print,'   LEVEL=L  Level of random starting pieces (def=0).'
  604.           print,'     If L is negative then starting pieces are gray.'
  605.           print,"   /BELL means ring bell for each line scored."
  606.           print,'   TOP=tp returns highest level for each piece played.'
  607.           print,'     Games are delimited by -1s.'
  608.           return
  609.         endif
  610.  
  611.         if n_elements(wt) eq 0 then wt = -1.
  612.         if wt eq -1. then wt = 0.05
  613.         if n_elements(lev) eq 0 then lev = 0
  614.  
  615.         top = [-1]      ; Start TOP array.
  616.  
  617. start:  t_init, wt, lev, bell=bell
  618.  
  619.         ;-------  Find top  ----------
  620.         tmp = fltarr(t_ny)
  621.         for j = 0, t_ny-1 do tmp[j] = total(t_brd[*,j])
  622.         mx = 1+max(where(tmp ne 0))
  623.         top = [top,mx]
  624.  
  625. rd:     k = strupcase(get_kbrd(1))
  626.         if (k eq 'H') then begin
  627.           t_help
  628.           goto, rd
  629.         endif
  630.         if k eq 'Q' then return
  631.         if k ne 'S' then goto, rd
  632.  
  633. loop1:  t_next
  634.  
  635. loop2:  ku = strupcase(get_kbrd(0))   ; Get key.
  636.         if ku eq ' ' then t_rot       ; Rotate.
  637.         if ku eq 'J' then t_left     ; Move left.
  638.         if ku eq 'L' then t_right    ; Move right.
  639.         if ku eq 'Q' then goto, over  ; Game over.
  640.         if ku eq 'P' then begin      ; Pause.
  641.           ku = get_kbrd(1)
  642.           goto, loop2
  643.         endif
  644.         t_drop, done=d, range=r      ; Drop piece.
  645.  
  646.         if d eq 1 then begin              ; Piece done moving.
  647.           ;-------  Find top  ----------
  648.           tmp = fltarr(t_ny)
  649.           for j = 0, t_ny-1 do tmp[j] = total(t_brd[*,j])
  650.           mx = 1+max(where(tmp ne 0))
  651.           top = [top,mx]
  652.           if min(r) ge t_ny-1 then begin  ; Game over?
  653.            goto, over
  654.           endif 
  655.           ;------  Erase current score.  ------
  656.           xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2),color=0
  657.           t_pc = t_pc + 1
  658.           xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2)
  659.           t_score, r                      ; Update score.
  660.           goto, loop1
  661.         endif
  662.  
  663.         goto, loop2
  664.  
  665.         ;------  Game over  -------
  666. over:   polyfill, [0,1,1,0]*(t_nx-1), [0,0,1,1]*(t_ny-1),$
  667.           color=0, spacing=.1, orient=0
  668.         polyfill, [0,1,1,0]*(t_nx-1), [0,0,1,1]*(t_ny-1),$
  669.           color=0, spacing=.1, orient=90
  670.  
  671.         ;--------  Wait for another start command.  ------
  672. loopw:  ku = strupcase(get_kbrd(1))
  673.  
  674.  
  675.         ;---------  Update session max values.  -----
  676.         if (ku eq 'S') or (ku eq 'Q') then begin
  677.           xyouts,/dev,size=1.8,520,160,strtrim(t_hpc,2),color=0
  678.           t_hpc = t_hpc > t_pc 
  679.           xyouts,/dev,size=1.8,520,160,strtrim(t_hpc,2)
  680.           xyouts,/dev,size=1.8,520,130,strtrim(t_hln,2),color=0
  681.           t_hln = t_hln > t_ln 
  682.           xyouts,/dev,size=1.8,520,130,strtrim(t_hln,2)
  683.           xyouts,/dev,size=1.8,520,100,strtrim(t_hsc,2),color=0
  684.           t_hsc = t_hsc > t_sc 
  685.           xyouts,/dev,size=1.8,520,100,strtrim(t_hsc,2)
  686.         endif
  687.  
  688.         ;---------  Handle S or Q  ---------
  689.         if ku eq 'S' then begin
  690.           t_init, wt, lev, bell=bell
  691.           top = [top,-1]
  692.           ;-------  Find top  ----------
  693.           tmp = fltarr(t_ny)
  694.           for j = 0, t_ny-1 do tmp[j] = total(t_brd[*,j])
  695.           mx = 1+max(where(tmp ne 0))
  696.           top = [top,mx]
  697.           goto, loop1
  698.         endif
  699.         if ku ne 'Q' then goto, loopw
  700.  
  701.         end
  702.  
  703.  
  704.